{-# LANGUAGE OverloadedStrings #-}

module HSimEngine( genImage ) where

import Control.Monad       ( forM_ )
import GSL.Random.Gen      ( newRNG, mt19937 )
import Image               ( Image(..), ImageD, mkImage, modifyPixel, modifyPixels, readPixel)
import Instrument          ( Instrument(..) )
import Instrument.CCD      ( CCD(..), genDarkNoise, genReadNoise )
import ObsObject           ( ObsObject(..) )
import ObsObject.CRayTrace ( genCRTraces )
import ObsObject.Star      ( genStars )
import PixObject           ( pixelization )


-- Поток космических частиц (шт * см^-2 * с^-1)

type CRFlux   = Double

-- Время экспозиции (сек.)

type Exposure = Double

--

addObjects :: ImageD -> Instrument -> CRFlux -> Exposure -> IO ()
addObjects img ins f e = do
    -- генерим объекты
    os <- genObjects ins f e

    -- пикселизуем объекты и добавляем их в общую картину
    modifyPixels img (+) $ concatMap (pixelization ins) os

--

genObjects :: Instrument -> CRFlux -> Exposure -> IO [ObsObject]
genObjects ins f e = do
    -- генерим следы от косм. частиц
    ts  <- genCRTraces f (w,h,t) e

    -- генерим звезды
    ss  <- genStars 20 ((-210,-210), (210,210)) e

    return $ (map ObsObject ts) ++ (map ObsObject ss)
--    return $ (map ObsObject ts)

    where
      -- получаем ccd-матрицу
      ccd = getCCD ins
      -- размер матрицы (в пикселях)
      t = thickness ccd
      w = fromIntegral $ width  ccd
      h = fromIntegral $ height ccd

--

addNoise :: ImageD -> CCD -> Exposure -> IO ()
addNoise img@(Image w h _) ccd e = do

    rng <- newRNG mt19937

    forM_ [(x,y) | x <- [1..w], y <-[1..h] ] $
       \(x,y) -> do
            d <- genDarkNoise rng dn
--            r <- genReadNoise rng rn
--            modifyPixel img (+) ((x,y), d + r)
            modifyPixel img (+) ((x,y), d)

    where
      dn = (dnoise ccd) * e
      rn =  rnoise ccd
      w  =  width  ccd
      h  =  height ccd

--

maxChargeLevel :: (Num a) => a
maxChargeLevel = 48800

-- Моделирование переноса заряда на соседние пиксели при достижении определенного уровня значения в пикселе

modelingChargeTransfer :: ImageD -> IO ()
modelingChargeTransfer img@(Image w h arr) =
    do
      -- проходися по всем пикселям картинки
      mapM_ ( procPixel ) [ (x,y) | x <- [1..w], y <- [1..h]]

    where
       procPixel (x,y) = 
          do
            -- получаем текущее значение в пикселе
            c <- readPixel img (x,y)

            -- определяем значение максимального уровня и величины равной количеству заряда,
            -- который должен перетечь выше и ниже данного пикселя.
            let l = maxChargeLevel
            let n = (c-l) / 2

            -- если текущее значение пикселя меньше мак. уровня, то ничего не делаем,
            -- если больше, то уменьшаем данного пикселя значение до максимального
            -- уровня и перемещаем избыток вверх и вниз в равной пропорции.
            case c < l of
               True  -> return ()
               False -> do
                          modifyPixel    img (-) ((x, y), 2*n)
                          transferTop    img  n   (x, y+1)
                          transferBottom img  n   (x, y-1)

-- Функции переноса заряда в верх и вниз соответственно

transferTop    img n p = transfer img ( 1+) n p
transferBottom img n p = transfer img (-1+) n p

transfer :: ImageD -> (Int -> Int) -> Double -> (Int, Int) -> IO ()
transfer img@(Image w h _) expr n (x,y) =

    -- если вышли за пределы допустимой области или перемещаемое значение
    -- равно нулю, то ничего не делаем, иначе выполняем перемещение

    case (y > h || y < 1 || n == 0) of
       True  -> return ()
       False -> do
                  -- получаем текущее значение в пикселе
                  c <- readPixel img (x,y)

                  -- определяем значение максимального уровня и величины равной количеству заряда,
                  -- которым можно было бы дополнить данный пиксель
                  let l  = maxChargeLevel                  
                  let dc = if c + n > l then l-c else n

                  -- если текущее значение пикселя больше или равно мак. уровню, то перемещаемся дальше
                  -- для поиска вакантного пикселя, иначе добавляем к значению данного пикселя величину
                  -- определенную выше и перемещаемся дальше, но уже с переносимой величиной, уменьшенной
                  -- на значение добавленное в данный пиксель
                  case c >= l of
                     True  -> transfer img expr n (x, expr y)
                     False -> do 
                                modifyPixel img (+)  ((x,y),  dc)
                                transfer    img expr (n-dc) (x, expr y)

 
genImage :: Instrument -> CRFlux -> Exposure -> IO ImageD
genImage ins f e = do

    img <- mkImage iw ih b

    addObjects img ins f' e

    addNoise img ccd e

    modelingChargeTransfer img
  
    return img

    where
      -- получаем ccd-матрицу
      ccd = getCCD ins

      -- размер изображения (в пикселях)
      (iw, ih) = (width ccd, height ccd)

      -- размер пикселя (в см.)
      (pw, ph) = psize ccd

      -- байс матрицы
      b = bias ccd

      -- поток космических частиц (в шт/пик^2)
      f' = f * pw * ph